home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / comint / shell.el < prev    next >
Encoding:
Text File  |  1995-05-17  |  31.2 KB  |  755 lines
  1. ;;; shell.el --- specialized comint.el for running the shell.
  2. ;;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Olin Shivers <shivers@cs.cmu.edu>
  5. ;; Adapted-by: Simon Marshall <s.marshall@dcs.hull.ac.uk>
  6. ;; Keywords: processes
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; Please send me bug reports, bug fixes, and extensions, so that I can
  27. ;;; merge them into the master source.
  28. ;;;     - Olin Shivers (shivers@cs.cmu.edu)
  29. ;;;     - Simon Marshall (s.marshall@dcs.hull.ac.uk)
  30.  
  31. ;;; This file defines a a shell-in-a-buffer package (shell mode) built
  32. ;;; on top of comint mode.  This is actually cmushell with things
  33. ;;; renamed to replace its counterpart in Emacs 18.  cmushell is more
  34. ;;; featureful, robust, and uniform than the Emacs 18 version.
  35.  
  36. ;;; Since this mode is built on top of the general command-interpreter-in-
  37. ;;; a-buffer mode (comint mode), it shares a common base functionality, 
  38. ;;; and a common set of bindings, with all modes derived from comint mode.
  39. ;;; This makes these modes easier to use.
  40.  
  41. ;;; For documentation on the functionality provided by comint mode, and
  42. ;;; the hooks available for customising it, see the file comint.el.
  43. ;;; For further information on shell mode, see the comments below.
  44.  
  45. ;;; Needs fixin:
  46. ;;; When sending text from a source file to a subprocess, the process-mark can 
  47. ;;; move off the window, so you can lose sight of the process interactions.
  48. ;;; Maybe I should ensure the process mark is in the window when I send
  49. ;;; text to the process? Switch selectable?
  50.  
  51. ;; YOUR .EMACS FILE
  52. ;;=============================================================================
  53. ;; Some suggestions for your .emacs file.
  54. ;;
  55. ;; ; If shell lives in some non-standard directory, you must tell emacs
  56. ;; ; where to get it. This may or may not be necessary.
  57. ;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
  58. ;;
  59. ;; ; Autoload shell from file shell.el
  60. ;; (autoload 'shell "shell"
  61. ;;           "Run an inferior shell process."
  62. ;;           t)
  63. ;;
  64. ;; ; Define C-c t to run my favorite command in shell mode:
  65. ;; (setq shell-mode-hook
  66. ;;       '((lambda () 
  67. ;;           (define-key shell-mode-map "\C-ct" 'favorite-cmd))))
  68.  
  69.  
  70. ;;; Brief Command Documentation:
  71. ;;;============================================================================
  72. ;;; Comint Mode Commands: (common to shell and all comint-derived modes)
  73. ;;;
  74. ;;; m-p        comint-previous-input            Cycle backwards in input history
  75. ;;; m-n        comint-next-input                  Cycle forwards
  76. ;;; m-r     comint-previous-matching-input  Previous input matching a regexp
  77. ;;; m-R     comint-previous-matching-input-from-input -"- matching input
  78. ;;; m-s     comint-next-matching-input      Next input that matches
  79. ;;; m-S     comint-next-matching-input-from-input     -"- matching input
  80. ;;; m-c-r   comint-previous-input-matching  Search backwards in input history
  81. ;;; return  comint-send-input
  82. ;;; c-a     comint-bol                      Beginning of line; skip prompt
  83. ;;; c-d        comint-delchar-or-maybe-eof        Delete char unless at end of buff.
  84. ;;; c-c c-u comint-kill-input                ^u
  85. ;;; c-c c-w backward-kill-word            ^w
  86. ;;; c-c c-c comint-interrupt-subjob         ^c
  87. ;;; c-c c-z comint-stop-subjob                ^z
  88. ;;; c-c c-\ comint-quit-subjob                ^\
  89. ;;; c-c c-o comint-kill-output            Delete last batch of process output
  90. ;;; c-c c-r comint-show-output            Show last batch of process output
  91. ;;; c-c c-h comint-dynamic-list-input-ring  List input history
  92. ;;;         send-invisible                  Read line w/o echo & send to proc
  93. ;;;         comint-continue-subjob        Useful if you accidentally suspend
  94. ;;;                            top-level job
  95. ;;; comint-mode-hook is the comint mode hook.
  96.  
  97. ;;; Shell Mode Commands:
  98. ;;;         shell                Fires up the shell process
  99. ;;; tab     comint-dynamic-complete        Complete filename/command/history
  100. ;;; m-?     comint-dynamic-list-filename-completions List completions in help buffer
  101. ;;; m-c-f   shell-forward-command           Forward a shell command
  102. ;;; m-c-b   shell-backward-command          Backward a shell command
  103. ;;;         dirs                    Resync the buffer's dir stack
  104. ;;;         shell-dirtrack-toggle           Turn dir tracking on/off
  105. ;;;
  106. ;;; The shell mode hook is shell-mode-hook
  107. ;;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards
  108. ;;; compatibility.
  109.  
  110. ;;; Read the rest of this file for more information.
  111.  
  112. ;;; SHELL.EL COMPATIBILITY
  113. ;;; Notes from when this was called cmushell, and was not the standard emacs
  114. ;;; shell package.
  115. ;;;============================================================================
  116. ;;; In brief: this package should have no trouble coexisting with shell.el.
  117. ;;; 
  118. ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the
  119. ;;; same, so the users shouldn't have much trouble. Hooks have different
  120. ;;; names, however, so you can customise shell mode differently from cmushell
  121. ;;; mode. You basically just have to remember to type M-x cmushell instead of
  122. ;;; M-x shell.
  123. ;;; 
  124. ;;; It would be nice if this file was completely plug-compatible with the old
  125. ;;; shell package -- if you could just name this file shell.el, and have it
  126. ;;; transparently replace the old one. But you can't.  Several other packages
  127. ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also
  128. ;;; clients of shell mode. These packages assume detailed knowledge of shell
  129. ;;; mode internals in ways that are incompatible with cmushell mode (mostly
  130. ;;; because of cmushell mode's greater functionality).  So, unless we are
  131. ;;; willing to port all of these packages, we can't have this file be a
  132. ;;; complete replacement for shell.el -- that is, we can't name this file
  133. ;;; shell.el, and its main entry point (shell), because dbx.el will break
  134. ;;; when it loads it in and tries to use it.
  135. ;;; 
  136. ;;; There are two ways to fix this. One: rewrite these other modes to use the
  137. ;;; new package. This is a win, but can't be assumed. The other, backwards
  138. ;;; compatible route, is to make this package non-conflict with shell.el, so
  139. ;;; both files can be loaded in at the same time. And *that* is why some
  140. ;;; functions and variables have different names: (cmushell),
  141. ;;; cmushell-mode-map, that sort of thing. All the names have been carefully
  142. ;;; chosen so that shell.el and cmushell.el won't tromp on each other.
  143.  
  144. ;;; Customization and Buffer Variables
  145. ;;; ===========================================================================
  146. ;;; 
  147.  
  148. ;;; Code:
  149.  
  150. (require 'comint)
  151.  
  152. ;;;###autoload
  153. (defvar shell-prompt-pattern (purecopy "^[^#$%>\n]*[#$%>] *")
  154.   "Regexp to match prompts in the inferior shell.
  155. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
  156. This variable is used to initialise `comint-prompt-regexp' in the
  157. shell buffer.
  158.  
  159. The pattern should probably not match more than one line.  If it does,
  160. shell-mode may become confused trying to distinguish prompt from input
  161. on lines which don't start with a prompt.
  162.  
  163. This is a fine thing to set in your `.emacs' file.")
  164.  
  165. ;jwz: turned this off; it's way too broken.
  166. (defvar shell-delimiter-argument-list nil;'("|" "&" "<" ">" "(" ")" ";")
  167.   "List of characters to recognise as separate arguments.
  168. Defaults to \(\"|\" \"&\" \"\(\" \")\" \";\"), which works pretty well.
  169. This variable is used to initialise `comint-delimiter-argument-list' in the
  170. shell buffer.
  171.  
  172. This is a fine thing to set in your `.emacs' file.")
  173.  
  174. (defvar shell-command-regexp "\\((.*)\\|[^;&|]\\)+"
  175.   "*Regexp to match shell commands.
  176. Elements of pipes are considered as separate commands, forks and redirections
  177. as part of one command.")
  178.  
  179. (defvar shell-completion-execonly t
  180.   "*If non-nil, use executable files only for completion candidates.
  181. This mirrors the optional behavior of tcsh.
  182.  
  183. Detecting executability of files may slow command completion considerably.")
  184.  
  185. (defvar shell-multiple-shells nil
  186.   "*If non-nil, each time shell mode is invoked, a new shell is made")
  187.  
  188. (defvar shell-popd-regexp "popd"
  189.   "*Regexp to match subshell commands equivalent to popd.")
  190.  
  191. (defvar shell-pushd-regexp "pushd"
  192.   "*Regexp to match subshell commands equivalent to pushd.")
  193.  
  194. (defvar shell-pushd-tohome nil
  195.   "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
  196. This mirrors the optional behavior of tcsh.")
  197.  
  198. (defvar shell-pushd-dextract nil
  199.   "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
  200. This mirrors the optional behavior of tcsh.")
  201.  
  202. (defvar shell-pushd-dunique nil
  203.   "*If non-nil, make pushd only add unique directories to the stack.
  204. This mirrors the optional behavior of tcsh.")
  205.  
  206. (defvar shell-cd-regexp "cd"
  207.   "*Regexp to match subshell commands equivalent to cd.")
  208.  
  209. (defvar explicit-shell-file-name nil
  210.   "*If non-nil, is file name to use for explicitly requested inferior shell.")
  211.  
  212. (defvar explicit-csh-args
  213.   (if (eq system-type 'hpux)
  214.       ;; -T persuades HP's csh not to think it is smarter
  215.       ;; than us about what terminal modes to use.
  216.       '("-i" "-T")
  217.     '("-i"))
  218.   "*Args passed to inferior shell by M-x shell, if the shell is csh.
  219. Value is a list of strings, which may be nil.")
  220.  
  221. (defvar shell-dirstack nil
  222.   "List of directories saved by pushd in this buffer's shell.
  223. Thus, this does not include the shell's current directory.")
  224.  
  225. (defvar shell-last-dir nil
  226.   "Keep track of last directory for ksh `cd -' command.")
  227.  
  228. (defvar shell-dirstack-query "dirs"
  229.   "Command used by `shell-resync-dirs' to query the shell.")
  230.  
  231. (defvar shell-dirtrackp)
  232.  
  233. (defvar shell-mode-map nil)
  234. (if (not shell-mode-map)
  235.     (let ((map (make-keymap)))
  236.       (set-keymap-parent map comint-mode-map)
  237.       (set-keymap-name map 'shell-mode-map)
  238.       (define-key map "\C-c\C-f" 'shell-forward-command)
  239.       (define-key map "\C-c\C-b" 'shell-backward-command)
  240.       (define-key map "\t" 'comint-dynamic-complete)
  241.       (define-key map "\M-?"  'comint-dynamic-list-filename-completions)
  242.       (setq shell-mode-map map)))
  243.  
  244. (defvar shell-mode-hook nil
  245.   "*Hook for customising Shell mode.")
  246.  
  247.  
  248. ;;; Basic Procedures
  249. ;;; ===========================================================================
  250. ;;;
  251.  
  252. (defun shell-mode ()
  253.   "Major mode for interacting with an inferior shell.
  254. Return after the end of the process' output sends the text from the 
  255.     end of process to the end of the current line.
  256. Return before end of process output copies the current line (except
  257.     for the prompt) to the end of the buffer and sends it.
  258. \\[send-invisible] reads a line of text without echoing it, and sends it to
  259.     the shell.  This is useful for entering passwords.
  260.  
  261. If you accidentally suspend your process, use \\[comint-continue-subjob]
  262. to continue it.
  263.  
  264. cd, pushd and popd commands given to the shell are watched by Emacs to keep
  265. this buffer's default directory the same as the shell's working directory.
  266. \\[shell-resync-dirs] queries the shell and resyncs Emacs' idea of what the 
  267.     current directory stack is.
  268. \\[shell-dirtrack-toggle] turns directory tracking on and off.
  269.  
  270. \\{shell-mode-map}
  271. Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and
  272. `shell-mode-hook' (in that order).   After each shell output, the hooks on
  273. `comint-output-filter-functions' are run.
  274.  
  275. Variable `shell-multiple-shells' will automaticly generate a new shell each
  276. time it is invoked.
  277.  
  278. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp'
  279. are used to match their respective commands, while `shell-pushd-tohome',
  280. `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the
  281. relevant command.
  282.  
  283. Variables `comint-completion-autolist', `comint-completion-addsuffix' and
  284. `comint-completion-recexact' control the behavior of file name, command name
  285. and variable name completion.  Variable `shell-completion-execonly' controls
  286. the behavior of command name completion.
  287.  
  288. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control
  289. the initialisation of the input ring history, and history expansion.
  290.  
  291. Variables `comint-output-filter-functions', `comint-scroll-to-bottom-on-input',
  292. and `comint-scroll-to-bottom-on-output' control whether input and output
  293. cause the window to scroll to the end of the buffer."
  294.   (interactive)
  295.   (comint-mode)
  296.   (setq major-mode 'shell-mode)
  297.   (setq mode-name "Shell")
  298.   (use-local-map shell-mode-map)
  299.   (make-local-variable 'comint-prompt-regexp)
  300.   (setq comint-prompt-regexp shell-prompt-pattern)
  301.   (make-local-variable 'comint-delimiter-argument-list)
  302.   (setq comint-delimiter-argument-list shell-delimiter-argument-list)
  303.   (make-local-variable 'comint-after-partial-filename-command)
  304.   (setq comint-after-partial-filename-command 'shell-after-partial-filename)
  305.   (make-local-variable 'comint-get-current-command)
  306.   (setq comint-get-current-command 'shell-get-current-command)
  307.   (make-local-variable 'comint-dynamic-complete-command-command)
  308.   (setq comint-dynamic-complete-command-command 'shell-dynamic-complete-command)
  309.   (make-local-variable 'paragraph-start)
  310.   (setq paragraph-start comint-prompt-regexp)
  311.   (make-local-variable 'shell-dirstack)
  312.   (setq shell-dirstack nil)
  313.   (make-local-variable 'shell-last-dir)
  314.   (setq shell-last-dir nil)
  315.   (make-local-variable 'shell-dirtrackp)
  316.   (setq shell-dirtrackp t)
  317.   (setq comint-input-sentinel 'shell-directory-tracker)
  318.   ;; shell-dependent assignments.
  319.   (let ((shell (car (process-command (get-buffer-process (current-buffer))))))
  320.     (setq comint-input-ring-file-name
  321.       (or (getenv "HISTFILE")
  322.           (cond ((string-match "csh\\'" shell) "~/.history")
  323.             ((string-match "bash\\'" shell) "~/.bash_history")
  324.             ((string-match "ksh\\'" shell) "~/.sh_history")
  325.             (t "~/.history")))))
  326.   (run-hooks 'shell-mode-hook)
  327.   (comint-read-input-ring)
  328.   (shell-dirstack-message))
  329.  
  330.  
  331. ;;;###autoload
  332. (defun shell ()
  333.   "Run an inferior shell, with I/O through buffer *shell*.
  334. If buffer exists but shell process is not running, make new shell.
  335. If buffer exists and shell process is running, 
  336.  just switch to buffer `*shell*'.
  337. Program used comes from variable `explicit-shell-file-name',
  338.  or (if that is nil) from the ESHELL environment variable,
  339.  or else from SHELL if there is no ESHELL.
  340. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
  341.  (Note that this may lose due to a timing error if the shell
  342.   discards input when it starts up.)
  343. The buffer is put in Shell mode, giving commands for sending input
  344. and controlling the subjobs of the shell.  See `shell-mode'.
  345. See also the variable `shell-prompt-pattern'.
  346.  
  347. The shell file name (sans directories) is used to make a symbol name
  348. such as `explicit-csh-args'.  If that symbol is a variable,
  349. its value is used as a list of arguments when invoking the shell.
  350. Otherwise, one argument `-i' is passed to the shell.
  351.  
  352. \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
  353.    (interactive)
  354.   (let ((buffer "*shell*")
  355.     (buffer-name (if shell-multiple-shells
  356.              "*shell*"
  357.                "shell")))
  358.   (cond ((or shell-multiple-shells
  359.          (not (comint-check-proc buffer)))
  360.      (let* ((prog (or explicit-shell-file-name
  361.               (getenv "ESHELL")
  362.               (getenv "SHELL")
  363.               "/bin/sh"))             
  364.         (name (file-name-nondirectory prog))
  365.         (startfile (concat "~/.emacs_" name))
  366.         (xargs-name (intern-soft (concat "explicit-" name "-args"))))
  367.        (setq buffer (set-buffer (apply 'make-comint buffer-name prog
  368.                        (if (file-exists-p startfile)
  369.                            startfile)
  370.                        (if (and xargs-name
  371.                             (boundp xargs-name))
  372.                            (symbol-value xargs-name)
  373.                          '("-i")))))
  374.        (shell-mode))))
  375.   (switch-to-buffer buffer)
  376.   (if shell-multiple-shells
  377.       (rename-buffer (generate-new-buffer-name "*shell*")))
  378.   ))
  379.  
  380.  
  381.  
  382. ;;; Directory tracking
  383. ;;; ===========================================================================
  384. ;;; This code provides the shell mode input sentinel
  385. ;;;     SHELL-DIRECTORY-TRACKER
  386. ;;; that tracks cd, pushd, and popd commands issued to the shell, and
  387. ;;; changes the current directory of the shell buffer accordingly.
  388. ;;;
  389. ;;; This is basically a fragile hack, although it's more accurate than
  390. ;;; the version in Emacs 18's shell.el. It has the following failings:
  391. ;;; 1. It doesn't know about the cdpath shell variable.
  392. ;;; 2. It cannot infallibly deal with command sequences, though it does well
  393. ;;;    with these and with ignoring commands forked in another shell with ()s.
  394. ;;; 3. More generally, any complex command is going to throw it. Otherwise,
  395. ;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
  396. ;;;    that, there's no way to catch shell commands where cd's are buried
  397. ;;;    inside conditional expressions, aliases, and so forth.
  398. ;;;
  399. ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
  400. ;;; messes it up. You run other processes under the shell; these each have
  401. ;;; separate working directories, and some have commands for manipulating
  402. ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
  403. ;;; commands that do *not* affect the current w.d. at all, but look like they
  404. ;;; do (e.g., the cd command in ftp).  In shells that allow you job
  405. ;;; control, you can switch between jobs, all having different w.d.'s. So
  406. ;;; simply saying %3 can shift your w.d..
  407. ;;;
  408. ;;; The solution is to relax, not stress out about it, and settle for
  409. ;;; a hack that works pretty well in typical circumstances. Remember
  410. ;;; that a half-assed solution is more in keeping with the spirit of Unix, 
  411. ;;; anyway. Blech.
  412. ;;;
  413. ;;; One good hack not implemented here for users of programmable shells
  414. ;;; is to program up the shell w.d. manipulation commands to output
  415. ;;; a coded command sequence to the tty. Something like
  416. ;;;     ESC | <cwd> |
  417. ;;; where <cwd> is the new current working directory. Then trash the
  418. ;;; directory tracking machinery currently used in this package, and
  419. ;;; replace it with a process filter that watches for and strips out
  420. ;;; these messages.
  421.  
  422. (defun shell-directory-tracker (str)
  423.   "Tracks cd, pushd and popd commands issued to the shell.
  424. This function is called on each input passed to the shell.
  425. It watches for cd, pushd and popd commands and sets the buffer's
  426. default directory to track these commands.
  427.  
  428. You may toggle this tracking on and off with \\[shell-dirtrack-toggle].
  429. If emacs gets confused, you can resync with the shell
  430. with \\[shell-resync-dirs].
  431.  
  432. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp',
  433. while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique'
  434. control the behavior of the relevant command.
  435.  
  436. Environment variables are expanded, see function `substitute-in-file-name'."
  437.   (if shell-dirtrackp
  438.       ;; We fail gracefully if we think the command will fail in the shell.
  439.       (condition-case err
  440.       (let ((start (progn (string-match "^[;\\s ]*" str) ; skip whitespace
  441.                   (match-end 0)))
  442.         end cmd arg1)
  443.         (while (string-match shell-command-regexp str start)
  444.           (setq end (match-end 0)
  445.             cmd (comint-arguments (substring str start end) 0 0)
  446.             arg1 (comint-arguments (substring str start end) 1 1))
  447.           (cond ((eq (string-match shell-popd-regexp cmd) 0)
  448.              (shell-process-popd (substitute-in-file-name arg1)))
  449.             ((eq (string-match shell-pushd-regexp cmd) 0)
  450.              (shell-process-pushd (substitute-in-file-name arg1)))
  451.             ((eq (string-match shell-cd-regexp cmd) 0)
  452.              (shell-process-cd (substitute-in-file-name arg1))))
  453.           (setq start (progn (string-match "[;\\s ]*" str end) ; skip again
  454.                  (match-end 0)))))
  455.     (error
  456.      ;; XEmacs change
  457.      (message nil)
  458.      (display-error err t)))))
  459.  
  460. ;; Like `cd', but prepends comint-file-name-prefix to absolute names.
  461. (defun shell-cd-1 (dir dirstack)
  462.   (condition-case nil
  463.       (progn (if (file-name-absolute-p dir)
  464.                  (cd-absolute (concat comint-file-name-prefix dir))
  465.                  (cd dir))
  466.              (setq shell-dirstack dirstack)
  467.              (shell-dirstack-message))
  468.     (file-error (message "Couldn't cd."))))
  469.  
  470. ;;; popd [+n]
  471. (defun shell-process-popd (arg)
  472.   (let ((num (or (shell-extract-num arg) 0)))
  473.     (cond ((and num (= num 0) shell-dirstack)
  474.            (shell-cd-1 (car shell-dirstack) (cdr shell-dirstack)))
  475.       ((and num (> num 0) (<= num (length shell-dirstack)))
  476.        (let* ((ds (cons nil shell-dirstack))
  477.           (cell (nthcdr (1- num) ds)))
  478.          (rplacd cell (cdr (cdr cell)))
  479.          (setq shell-dirstack (cdr ds))
  480.          (shell-dirstack-message)))
  481.           (t
  482.        (error (message "Couldn't popd."))))))
  483.  
  484.  
  485. ;;; cd [dir]
  486. (defun shell-process-cd (arg)
  487.   (let ((new-dir (cond ((zerop (length arg)) (getenv "HOME"))
  488.                        ((string-equal "-" arg) shell-last-dir)
  489.                        (t arg))))
  490.     (setq shell-last-dir default-directory)
  491.     (shell-cd-1 new-dir shell-dirstack)))
  492.  
  493. ;;; pushd [+n | dir]
  494. (defun shell-process-pushd (arg)
  495.   (let ((num (shell-extract-num arg)))
  496.     (cond ((zerop (length arg))
  497.        ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
  498.        (cond (shell-pushd-tohome
  499.           (shell-process-pushd "~"))
  500.                  (shell-dirstack
  501.                   (let ((old default-directory))
  502.                     (shell-cd-1 (car shell-dirstack)
  503.                                 (cons old (cdr shell-dirstack)))))
  504.                  (t
  505.                   (message "Directory stack empty."))))
  506.       ((numberp num)
  507.        ;; pushd +n
  508.            (cond ((> num (length shell-dirstack))
  509.                   (message "Directory stack not that deep."))
  510.                  ((= num 0)
  511.           (error (message "Couldn't cd.")))
  512.          (shell-pushd-dextract
  513.           (let ((dir (nth (1- num) shell-dirstack)))
  514.             (shell-process-popd arg)
  515.             (shell-process-pushd default-directory)
  516.             (shell-cd-1 dir shell-dirstack)))
  517.                  (t
  518.                   (let* ((ds (cons default-directory shell-dirstack))
  519.                          (dslen (length ds))
  520.                          (front (nthcdr num ds))
  521.                          (back (reverse (nthcdr (- dslen num) (reverse ds))))
  522.                          (new-ds (append front back)))
  523.                     (shell-cd-1 (car new-ds) (cdr new-ds))))))
  524.       (t
  525.            ;; pushd <dir>
  526.            (let ((old-wd default-directory))
  527.              (shell-cd-1 arg
  528.                          (if (or (null shell-pushd-dunique)
  529.                                  (not (member old-wd shell-dirstack)))
  530.                              (cons old-wd shell-dirstack)
  531.                              shell-dirstack)))))))
  532.  
  533. ;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
  534. (defun shell-extract-num (str)
  535.   (and (string-match "^\\+[1-9][0-9]*$" str)
  536.        (string-to-int str)))
  537.  
  538.  
  539. (defun shell-dirtrack-toggle ()
  540.   "Turn directory tracking on and off in a shell buffer."
  541.   (interactive)
  542.   (setq shell-dirtrackp (not shell-dirtrackp))
  543.   (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF")))
  544.  
  545. ;;; For your typing convenience:
  546. ;; XEmacs: removed this because then `M-x dir' doesn't complete to `dired'
  547. ;;(define-function 'dirtrack-toggle 'shell-dirtrack-toggle)
  548.  
  549. (defun shell-resync-dirs ()
  550.   "Resync the buffer's idea of the current directory stack.
  551. This command queries the shell with the command bound to 
  552. `shell-dirstack-query' (default \"dirs\"), reads the next
  553. line output and parses it to form the new directory stack.
  554. DON'T issue this command unless the buffer is at a shell prompt.
  555. Also, note that if some other subprocess decides to do output
  556. immediately after the query, its output will be taken as the
  557. new directory stack -- you lose. If this happens, just do the
  558. command again."
  559.   (interactive)
  560.   (let* ((proc (get-buffer-process (current-buffer)))
  561.      (pmark (process-mark proc)))
  562.     (goto-char pmark)
  563.     (insert shell-dirstack-query) (insert "\n")
  564.     (sit-for 0) ; force redisplay
  565.     (comint-send-string proc shell-dirstack-query) 
  566.     (comint-send-string proc "\n")
  567.     (set-marker pmark (point))
  568.     (let ((pt (point))) ; wait for 1 line
  569.       ;; This extra newline prevents the user's pending input from spoofing us.
  570.       (insert "\n") (backward-char 1)
  571.       (while (not (looking-at ".+\n"))
  572.     (accept-process-output proc)
  573.     (goto-char pt)
  574.     ;; kludge to cope with shells that have "stty echo" turned on.
  575.     ;; of course this will lose if there is only one dir on the stack
  576.     ;; and it is named "dirs"...  -jwz
  577.     (if (looking-at "^dirs\r?\n") (delete-region (point) (match-end 0)))
  578.     ))
  579.     (goto-char pmark) (delete-char 1) ; remove the extra newline
  580.     ;; That's the dirlist. grab it & parse it.
  581.     (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
  582.        (dl-len (length dl))
  583.        (ds '())            ; new dir stack
  584.        (i 0))
  585.       (while (< i dl-len)
  586.     ;; regexp = optional whitespace, (non-whitespace), optional whitespace
  587.     (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
  588.     (setq ds (cons (substring dl (match-beginning 1) (match-end 1))
  589.                ds))
  590.     (setq i (match-end 0)))
  591.       (let ((ds (reverse ds)))
  592.         (shell-cd-1 (car ds) (cdr ds))))))
  593.  
  594. ;;; For your typing convenience:
  595. ;; XEmacs: removed this because then `M-x dir' doesn't complete to `dired'
  596. ;(define-function 'dirs 'shell-resync-dirs)
  597.  
  598. ;; XEmacs addition
  599. (defvar shell-dirstack-message-hook nil
  600.   "Hook to run after a cd, pushd or popd event")
  601.  
  602. ;;; Show the current dirstack on the message line.
  603. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
  604. ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
  605. ;;; All the commands that mung the buffer's dirstack finish by calling
  606. ;;; this guy.
  607. (defun shell-dirstack-message ()
  608.   (let* ((msg "")
  609.          (ds (cons default-directory shell-dirstack))
  610.          (home (format "^%s\\(/\\|$\\)" (regexp-quote (getenv "HOME"))))
  611.          (prefix (and comint-file-name-prefix
  612.               ;; XEmacs addition: don't turn "/foo" into "foo" !!
  613.               (not (= 0 (length comint-file-name-prefix)))
  614.                       (format "^%s\\(/\\|$\\)"
  615.                               (regexp-quote comint-file-name-prefix)))))
  616.     (while ds
  617.       (let ((dir (car ds)))
  618.     (if (string-match home dir)
  619.         (setq dir (concat "~/" (substring dir (match-end 0)))))
  620.     ;; Strip off comint-file-name-prefix if present.
  621.     (and prefix (string-match prefix dir)
  622.          (setq dir (substring dir (match-end 0)))
  623.              (setcar ds dir)
  624.              )
  625.     (setq msg (concat msg dir " "))
  626.     (setq ds (cdr ds))))
  627.     ;; XEmacs change
  628.     (run-hooks 'shell-dirstack-message-hook)
  629.     (message msg)))
  630.  
  631.  
  632. (defun shell-forward-command (&optional arg)
  633.   "Move forward across ARG shell command(s).  Does not cross lines.
  634. See `shell-command-regexp'."
  635.   (interactive "p")
  636.   (let ((limit (save-excursion (end-of-line nil) (point))))
  637.     (if (re-search-forward (concat shell-command-regexp "\\([;&|][\\s ]*\\)+")
  638.                limit 'move arg)
  639.     (skip-syntax-backward "^\\s "))))
  640.  
  641.  
  642. (defun shell-backward-command (&optional arg)
  643.   "Move backward across ARG shell command(s).  Does not cross lines.
  644. See `shell-command-regexp'."
  645.   (interactive "p")
  646.   (let ((limit (save-excursion (comint-bol nil) (point))))
  647.     (skip-syntax-backward "\\s " limit)
  648.     (if (re-search-backward
  649.      (format "[;&|]+[\\s ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
  650.     (progn (goto-char (match-beginning 1))
  651.            (skip-syntax-backward "^\\s ")))))
  652.  
  653.  
  654. (defun shell-get-current-command ()
  655.   "Function that returns the current command including arguments."
  656.   (save-excursion
  657.     (if (looking-at "\\s *[^;&|]")
  658.     (goto-char (match-end 0)))
  659.     (buffer-substring
  660.      (progn (shell-backward-command 1) (point))
  661.      (progn (shell-forward-command 1) (if (eolp) (point) (match-end 1))))))
  662.  
  663.  
  664. (defun shell-after-partial-filename ()
  665.   "Returns t if point is after a file name.
  666. File names are assumed to contain `/'s or not be the first item in the command.
  667.  
  668. See also `shell-backward-command'."
  669.   (let ((filename (comint-match-partial-filename)))
  670.     (or (save-match-data (string-match "/" filename))
  671.     (not (eq (match-beginning 0)
  672.          (save-excursion (shell-backward-command 1) (point)))))))
  673.  
  674.  
  675. (defun shell-dynamic-complete-command ()
  676.   "Dynamically complete the command at point.
  677. This function is similar to `comint-dynamic-complete-filename', except that it
  678. searches `exec-path' (minus the trailing emacs library path) for completion
  679. candidates.  Note that this may not be the same as the shell's idea of the
  680. path.
  681.  
  682. Completion is dependent on the value of `shell-completion-execonly', plus
  683. those that effect file completion.  See `comint-dynamic-complete-filename'."
  684.   (interactive)
  685.   (let* ((completion-ignore-case nil)
  686.      (filename (comint-match-partial-filename))
  687.      (pathnondir (file-name-nondirectory filename))
  688.      (paths (cdr (reverse exec-path)))
  689.      (cwd (file-name-as-directory (expand-file-name default-directory)))
  690.      (ignored-extensions
  691.       (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
  692.              completion-ignored-extensions "\\|"))
  693.      (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
  694.     ;; Go thru each path in the search path, finding completions.
  695.     (while paths
  696.       (setq path (file-name-as-directory (comint-directory (or (car paths) ".")))
  697.         comps-in-path (and (file-accessible-directory-p path)
  698.                    (file-name-all-completions pathnondir path)))
  699.       ;; Go thru each completion found, to see whether it should be used.
  700.       (while comps-in-path
  701.     (setq file (car comps-in-path)
  702.           filepath (concat path file))
  703.     (if (and (not (member file completions))
  704.          (not (string-match ignored-extensions file))
  705.          (or (string-equal path cwd)
  706.              (not (file-directory-p filepath)))
  707.          (or (null shell-completion-execonly)
  708.              (file-executable-p filepath)))
  709.         (setq completions (cons file completions)))
  710.     (setq comps-in-path (cdr comps-in-path)))
  711.       (setq paths (cdr paths)))
  712.     ;; OK, we've got a list of completions.
  713.     (cond ((null completions)
  714.         (message "No completions of %s" filename)
  715.         (ding))
  716.        ((= 1 (length completions))    ; Gotcha!
  717.         (let ((completion (car completions)))
  718.           (if (string-equal completion pathnondir)
  719.           (message "Sole completion")
  720.             (insert (substring (directory-file-name completion)
  721.                    (length pathnondir)))
  722.             (message "Completed"))
  723.           (if comint-completion-addsuffix
  724.           (insert (if (file-directory-p completion) "/" " ")))))
  725.        (t                ; There's no unique completion.
  726.         (let ((completion
  727.            (try-completion pathnondir (mapcar (function (lambda (x)
  728.                                   (list x)))
  729.                               completions))))
  730.           ;; Insert the longest substring.
  731.           (insert (substring (directory-file-name completion)
  732.                  (length pathnondir)))
  733.           (cond ((and comint-completion-recexact comint-completion-addsuffix
  734.               (string-equal pathnondir completion)
  735.               (member completion completions))
  736.              ;; It's not unique, but user wants shortest match.
  737.              (insert (if (file-directory-p completion) "/" " "))
  738.              (message "Completed shortest"))
  739.             ((or comint-completion-autolist
  740.              (string-equal pathnondir completion))
  741.              ;; It's not unique, list possible completions.
  742.              (comint-dynamic-list-completions completions))
  743.             (t
  744.              (message "Partially completed"))))))))
  745. (provide 'shell)
  746.  
  747. ;;; Eric Benson 7/10/91
  748. ;;;   Adapted for Emacs 19 by renaming cmushell to shell everywhere.
  749. ;;;   Removed (fset 'dirs 'shell-resync-dirs), as that causes M-X dir
  750. ;;;    to not call dired.
  751. ;;;   Instead of calling cd directly, use comint-cd which does
  752. ;;;    substitute-in-file-name.
  753.  
  754. ;;; shell.el ends here
  755.